home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / SURFMODL.PAS < prev    next >
Pascal/Delphi Source File  |  1991-11-24  |  18KB  |  441 lines
  1. {$I defines.inc }
  2.  
  3. program SURFMODL;
  4.  
  5. uses
  6. {$IFDEF ANSICRT}
  7.      ansicrt,
  8. {$ELSE}
  9.      crt,
  10. {$ENDIF}
  11.      dos,
  12.      SURFGRAF,       { Graphics Routines }
  13. {$IFDEF USE_IFF}
  14.      SURFBGI,
  15. {$ENDIF}
  16.      SHAREDEC;       { Shared Declarations between SURFMODL & SURFGRAF }
  17.  
  18. {$IFDEF USE8087}
  19. type
  20.   REAL = single;
  21. {$ENDIF}
  22.  
  23. const
  24. {$IFDEF USE8087}
  25.    Surfmvsn: string[10] = '3.00c 8087';
  26. {$ELSE}
  27.    Surfmvsn: string[5] = '3.00c';           { version number }
  28. {$ENDIF}
  29.    Lastupd: string[20] = '24 November 1991';     { date of last update }
  30.  
  31. { SURFMODL: Surface modeling in three dimensions.
  32.  
  33.   SURFMODL is distributed without any warranty, express or implied.
  34.   In no event shall the authors be liable for any loss of profit or
  35.   any other commercial damage, including but not limited to
  36.   special, incidental, consequential or other damages.
  37.  
  38.   SURFMODL may be freely distributed, or distributed at nominal
  39.   copying/mailing fee, but may not be otherwise charged for.
  40.   It may not be distributed with commercial software without
  41.   express written permission of the principle author:
  42.     Kenneth Van Camp
  43.     R.D. #1 Box 1255
  44.     East Stroudsburg, PA  18301
  45.     U.S.A.
  46.  
  47.   HISTORY OF MODIFICATIONS:
  48.     Version 1.0   (February 1987)
  49.     Version 1.1   (March    1987) - Added preliminary support for Borland's
  50.         Turbo Graphix Toolbox, and axes on the plots.
  51.     Version 1.1A  (April    1987) - Added Russell Nelson's updates for
  52.         HZ-100 without Toolbox
  53.     Version 1.2   (May      1987) - Added Russell Nelson's updates for
  54.         EGA without Toolbox. Changed NORMALIZ.PAS to NORMALIZ.PRE and
  55.         added a check for the YREVERSE preprocessor definition. Added
  56.         a check in SURFMODL.PRE for the NO_OVLY preprocessor definition,
  57.         so SURFMODL is not overlaid.
  58.     Version 1.3   (November 1987) - Added Ian Murphy's updates to use
  59.         pointers into the heap for all the major arrays, if BIGMEM is
  60.         defined.  Fixed thick/thin line problem in hidden line removal,
  61.         per Brad Keister.  Allowed Toolbox versions to call windowing
  62.         routines.  Fixed Read New File problem in PARAMENU.  Fixed dithering
  63.         problem in FILLSURF where Pcolor was not defined.  Fixed interpolated
  64.         shading problem in INTRFILL where a surface was allowed to have a
  65.         shade of 0, and Pcolor was not defined.  Fixed Axis-drawing bug.
  66.         Added abort capability during plotting.  Modified all menu reads
  67.         so hitting Enter keeps old value.  Added random shading in Gouraud
  68.         interpolation.  Added "status dots" at bottom of graphics screen.
  69.         Speeded up non-Gouraud surface filling by adding special horizontal
  70.         line-draw routine.  Added supported for the QuadEGA Prosync graphics
  71.         card, as provided by Rainer Kleinrensing.  Added in-line assembly
  72.         code by Klara Schroeder and Jochen Kraemer to support Hercules
  73.         graphics adapter without the Turbo Graphix Toolbox.
  74.     Version 1.31  (December 1987) - Took out in-line assembly code for
  75.         Hercules, and went back to the Toolbox code.  This is the ONLY
  76.         difference between versions 1.3 and 1.31!
  77.     Version 2.00  (January 1988)  - Converted to Turbo Pascal 4.0 by Kevin
  78.         Lowey.  Many minor changes such as having menu ask if you really
  79.         want to quit.  Major changes included use of built in preprocessor
  80.         directives (eliminating the need for mprep) and use of Borland
  81.         Graphics Interface (BGI).  All SURFMODL graphics primitives are now
  82.         in the unit SURFGRAF.PAS.  If non-BGI supported devices are used
  83.         (such as the enclosed DEC VAXmate driver) then the unit SURFBGI is
  84.         included.  This unit emulates the BGI functions used by SURFMODL.
  85.  
  86.         The systems supported have changed.  Support was dropped (for now)
  87.         for the Sanyo and Zenith Z-100 computers, but full support for the
  88.         BGI systems (see Turbo 4 manual)  are supported.  Because of
  89.         these changes the SYSTEM value in the .INI files has been changed.
  90.         This program will read version 3 and earlier .INI files, but creates
  91.         version 4 .INI files.  In addition to storing the graphics system,
  92.         the graphics mode on that system is now also stored, and you can
  93.         select the mode from the parameters menu.
  94.  
  95.         Benefits: Drawings which used to take 1.5 minutes to draw now take
  96.         one minute.  Device independant support for CGA, EGA, VGA, MCGA,
  97.         Hercules Mono, and AT&T computers are provided, and overlays are no
  98.         longer needed.
  99.  
  100.         A minor change to the shading calculation was provided by Steve Enns
  101.         of the University of Saskatchewan.  It eliminates the "normalization"
  102.         of the data points done in the shading calculation.  The end results
  103.         are the same but some floating point operations have been deleted,
  104.         speeding up the program a bit.
  105.  
  106.         A new option, "F" is now available when a completed image is on the
  107.         screen.  Typing "F" will save the current image into a file called
  108.         SURFMODL.PIC.  You can play back sequences of these images with the
  109.         new utility program called PLAYBACK.
  110.  
  111.         IFDEF support for the 8087 chip has been added.
  112.  
  113.     Version 2.10 (August 1989 KVC) - Added support for a Commodore Amiga 
  114.         hooked up remotely through the serial port and running the Gterm 
  115.         software to turn it into an intelligent graphics terminal.
  116.     Version 2.11 (September 1990 KVC) - Fixed bugs in fillsurf and intrfill
  117.         when the display color # exceeds the maximum color # of the device.
  118.         Added option to show surface borders in shaded plots.
  119.     Version 3.00 (September 1991 KVC) - Added support for full palette of
  120.         VGA; fixed bug saving screens > 64KB; added surface border plot
  121.         option; changed to symbolic language data files; added support
  122.         for SURFMODL.CFG file; fixed bug in readfile when premature EOF
  123.         encountered; added interactive file selector; removed autodetect
  124.         of graphics device (use SURFMODL.CFG and SURFINST instead); added
  125.         support for higher-resolution devices (Super VGA); changed global
  126.         array allocation so array bounds determined at run time and
  127.         dynamically allocated; added performance statistics in main menu;
  128.         added IFF support for the Amiga.
  129. }
  130.  
  131.  
  132. {$ifdef BIGMEM}
  133. const MAXNODES: word = 0;     { maximum # of nodes in the entire solid }
  134.       MAXCONNECT: word = 0;   { maximum # of connections in entire solid }
  135.       MAXSURF: word = 0;      { maximum # of surfaces in entire solid }
  136. {$else}
  137. const MAXNODES = 1024;      { maximum # of nodes in the entire solid }
  138.       MAXCONNECT = 4096;    { maximum # of connections in entire solid }
  139.       MAXSURF = 1365;       { maximum # of surfaces in entire solid }
  140.                             { (MAXSURF = MAXCONNECT / 3) }
  141. {$endif}
  142.  
  143.       MAXPTS = 600;         { maximum # of line points (in fillsurf) }
  144.       MAXFILES = 200;       { maximum # of files to select from }
  145.  
  146.  
  147. type  points = array[1..MAXPTS] of integer;
  148.       realpts = array[1..MAXPTS] of real;
  149.       vector = array[1..3] of real;
  150.       matlarray = array[1..MAXMATL] of integer;
  151.       filename = string[12];
  152.       filelist = array[1..MAXFILES] of filename;
  153. {$ifdef BIGMEM}
  154.       surfaces = array[1..1] of real;
  155.       nodearray= array[1..1] of real;
  156. {$else}
  157.       surfaces = array[1..MAXSURF] of real;
  158.       nodearray= array[1..MAXNODES] of real;
  159. {$endif}
  160.  
  161. {$ifdef BIGMEM}
  162.   { A note on the BIGMEM definition:  Everything included under this
  163.     section is a trick designed to overcome the memory limitations
  164.     imposed by Turbo Pascal version 3.x and below.  Since TP limits
  165.     all variable storage to one segment (64K), the following pointer
  166.     definitions overcome this by storing the major SURFMODL arrays
  167.     in the heap space.
  168.   }
  169.       heaparray1 = record Xworld:nodearray;
  170.                    end;
  171.       hptr1 = ^heaparray1;
  172.       heaparray2 = record Yworld:nodearray;
  173.                    end;
  174.       hptr2 = ^heaparray2;
  175.       heaparray3 = record Zworld:nodearray;
  176.                    end;
  177.       hptr3 = ^heaparray3;
  178.  
  179.       heaparray4 = record Xtran:nodearray;
  180.                    end;
  181.       hptr4 = ^heaparray4;
  182.       heaparray5 = record Ytran:nodearray;
  183.                    end;
  184.       hptr5 = ^heaparray5;
  185.       heaparray6 = record Ztran:nodearray;
  186.                    end;
  187.       hptr6 = ^heaparray6;
  188.       heaparray7 = record Connect :array[1..1] of word;
  189.                    end;
  190.       hptr7 = ^heaparray7;
  191.       heaparray8 = record Nvert : array[1..1] of integer;
  192.                    end;
  193.       hptr8 = ^heaparray8;
  194.       heaparray9 = record Matl : array[1..1] of integer;
  195.                    end;
  196.       hptr9 = ^heaparray9;
  197.       heaparray10 = record Shades : nodearray;
  198.                    end;
  199.       hptr10 = ^heaparray10;
  200.       heaparray11 = record  Surfmin : surfaces;
  201.                    end;
  202.       hptr11 = ^heaparray11;
  203.       heaparray12 = record Nshades  : array[1..1] of integer;
  204.                    end;
  205.       hptr12 = ^heaparray12;
  206.       heaparray13 = record Sshade   : surfaces;
  207.                    end;
  208.       hptr13 = ^heaparray13;
  209.       heaparray14 = record  Surfmax : surfaces;
  210.                    end;
  211.       hptr14 = ^heaparray14;
  212. {$endif}
  213.  
  214. {$ifdef BIGMEM}
  215. var   ptra : hptr1;   { Xworld }
  216.       ptrb : hptr2;   { Yworld }
  217.       ptrc : hptr3;   { Zworld }
  218.       ptrd : hptr4;   { Xtran }
  219.       ptre : hptr5;   { Ytran }
  220.       ptrf : hptr6;   { Ztran }
  221.       ptrg : hptr7;   { Connect }
  222.       ptrh : hptr8;   { Nvert }
  223.       ptri : hptr9;   { Matl }
  224.       ptrj : hptr10;  { Shades }
  225.       ptrk : hptr11;  { Surfmin }
  226.       ptrl : hptr12;  { Nshades }
  227.       ptrm : hptr13;  { Sshade }
  228.       ptrn : hptr14;  { Surfmax }
  229. {$ELSE}
  230. var   Xworld, Yworld, Zworld: nodearray;
  231.         { world coordinates of each node }
  232.       Xtran, Ytran, Ztran: nodearray;
  233.         { transformed coordinates of each node }
  234.       Connect: array[1..MAXCONNECT] of word;
  235.         { surface connectivity data }
  236.       Nvert: array[1..MAXSURF] of integer;
  237.         { # vertices per surface }
  238.       Matl: array[1..MAXSURF] of integer;
  239.         { material number of each surface }
  240.       { NOTE: The Shades, Surfmin, Surfmax, Nshades and Sshade arrays are
  241.         defined in the individual procedures that require them, to save
  242.         global variable space. }
  243. {$endif}
  244.       R1, R2, R3: array[1..MAXMATL] of real;
  245.         { material reflectivity constants }
  246.       Color: array[1..MAXMATL] of integer;
  247.         { material color number }
  248.       Ambient: array[1..MAXMATL] of real;
  249.         { ambient light intensity for each material }
  250.       Xlite, Ylite, Zlite: array[1..MAXLITE] of real;
  251.         { coords of light sources }
  252.       Intensity: array[1..MAXLITE] of real;
  253.         { light source intensities }
  254.  
  255.       Xeye, Yeye, Zeye: real;              { coords of eye }
  256.       Xfocal, Yfocal, Zfocal: real;        { coords of focal point }
  257.       Maxvert: integer;                    { max # vertices per surface }
  258.       Nsurf: word;                         { # surfaces }
  259.       Nnodes: word;                        { # nodes }
  260.       Nlite: integer;                      { # light sources }
  261.       Magnify: real;                       { magnification factor }
  262.       Viewtype: integer;                   { code for viewing type: }
  263.                                            { 0=perspective, 1=XY, 2=XZ, 3=YZ }
  264.       Fileread: boolean;                   { flag first file read }
  265.       Nmatl: integer;                      { number of materials }
  266.       Nsides: integer;                     { #sides of surface used (1 or 2)}
  267.       Interpolate: boolean;                { flag for Gouraud interpolation }
  268.       Epsilon: real;                       { Gouraud interpolation range }
  269.       Shadowing: boolean;                  { flag shadowing option }
  270.       Filemask: text80;                    { mask for naming data files }
  271.       Inifile: text80;                     { name of INI file }
  272.       Grfcmmdfile: text80;
  273.       XYadjust: real;                      { factor for screen width }
  274.       Showaxes: integer;                   { code to show (0) no axes; (1) }
  275.                                            { axis directions; (2) full axes }
  276.       Xaxislen,Yaxislen,Zaxislen: real;    { lengths of axes }
  277.       Axiscolor: integer;                  { color to draw axes }
  278.       Nwindow: integer;                    { # graphics windows on screen }
  279.       Xfotran, Yfotran, Zfotran: real;     { transformed focal point }
  280.       XYmax: real;                         { limits of transformed coords }
  281.       memerr : boolean;                    { True if a memory error occured }
  282.       ShowAllBorders: integer;             { code to (1) show surface borders}
  283.                                            { in shaded plots or (0) not }
  284.       Zmin,Zmax: real;                     { min & max Z coords }
  285.       Lastplot: integer;                   { last plot type }
  286.       Save_cmmd: string;                   { cmmd saved from cmmd-line }
  287.  
  288. { An important function for decoding the Connect array: }
  289.  
  290. function KONNEC (Surf: word; Vert: integer): word;
  291. { Decode the Connect array to yield the connection data: Vertex Vert of
  292. surface Surf. This function returns an index to the global Xtran, Ytran,
  293. and Ztran arrays (i.e., a node number) }
  294. begin
  295. {$ifdef BIGMEM}
  296. with ptrg^ do
  297. begin
  298. {$endif}
  299.   Konnec := Connect[(Surf-1) * Maxvert + Vert];
  300. {$ifdef BIGMEM}
  301. end; {with}
  302. {$endif}
  303. end; { function KONNEC }
  304.  
  305. { Procedure include files }
  306.  
  307. { Graphics Functions }
  308. {$I COLORMOD.INC}         { COLORMOD }
  309. {$I DITHER.INC  }         { Graphics Dithering functions }
  310. {$I OPENWIN.INC }         { procedure BRIGHT, OPENWIN }
  311.  
  312. {$I MENUMSG.INC }         { procedure MENUMSG }
  313.  
  314. { Math routines and number input routines}
  315. {$I ARCCOS.INC  }         { function  ARCCOS }
  316. {$I MINMAX.INC }          { procedure MINMAX }
  317. {$I GETKEY.INC  }         { function  GETKEY }
  318. {$I CHKCMMD.INC }         { procedure CHKCMMD }
  319. {$I INREAL.INC }          { function  INREAL }
  320. {$I GETONE.INC }          { functions GETONEREAL, GETONEINT }
  321.  
  322. { File Handling routines }
  323. {$I READCFG.INC }         { procedure READCFG }
  324. {$I WRITECFG.INC }        { procedure WRITECFG }
  325. {$I ALLOC.INC }           { functions ALLOC_NODES, ALLOC_SURFS }
  326. {$I READFILE.INC }        { procedure OPENFILE, READFILE }
  327.  
  328. { startup routines }
  329. {$I INITIAL.INC }         { procedure INITIAL }
  330. {$I TITLESCR.INC }        { procedure TITLESCREEN }
  331.  
  332. { Menuing Functions }
  333. {$I FILESEL.INC }         { procedure SORTFILES,DISP_NAME,REFRESH_FILES,
  334.                                       FILE_SELECT }
  335. {$I LITEMENU.INC }        { procedure LITEMENU }
  336. {$I PARAMENU.INC }        { procedure PARAMENU }
  337. {$I PERFORM.INC }         { procedure PERF_START,PERF_STOP,PERF_SHOW }
  338. {$I MENU.INC }            { procedure MENU }
  339.  
  340. { Modeling Functions }
  341. {$I PERSPECT.INC }        { procedure SETORG, PERSPECT }
  342. {$I NORMALIZ.INC }        { procedure SETNORMAL, NORMALIZE }
  343. {$I CHECKEY.INC }         { function  CHECKEY }
  344. {$I CONTINUE.INC }        { procedure CONTINUE }
  345. {$I BORDER.INC }          { procedure BORDER }
  346. {$I DRAWAXES.INC }        { procedure DRAWAXES }
  347. {$I WIREFRAM.INC }        { procedure WIREFRAME }
  348. {$I ONSCREEN.INC }        { function  ONSCREEN }
  349. {$I STORLINE.INC }        { procedure STORLINE }
  350. {$I SWAPS.INC }           { procedure SWAPINT, SWAPREAL }
  351. {$I SHELLPTS.INC }        { procedure SHELLPTS, SHELLSHADES }
  352. {$I FILLSURF.INC }        { procedure BADSURF, FILLSURF }
  353. {$I SHELSURF.INC }        { procedure SWAPSURF,SHELSURF }
  354. {$I SHADING.INC }         { procedure NORMAL, POWER,SETSHADE,SHADING,VISIBLE}
  355. {$I HIDNLINE.INC }        { procedure HIDDENLINE }
  356.  
  357. {$ifndef NOSHADOW}
  358. {$I INLIMITS.INC }        { function  INLIMITS (for shadowing) }
  359. {$I CHEKSURF.INC }        { function  CHEKSURF (for shadowing) }
  360. {$I SHADOWS.INC }         { procedure SHADOWS  (for shadowing) }
  361. {$endif}
  362.  
  363. {$I SURFACE.INC }         { procedure SURFACE }
  364. {$I STORSHAD.INC }        { procedure STORSHADES }
  365. {$I INTRFILL.INC }        { procedure INTRFILL }
  366. {$I GOURAUD.INC }         { procedure GOURAUD }
  367.  
  368. { Local variables for main procedure }
  369. var  Cmmd: integer;       { user command }
  370.      Imemavail: longint;  { initial memory available }
  371.      Flnm: text80;        { file name to read }
  372.      ch: char;
  373.  
  374. begin   { SURFMODL main program }
  375. {$IFDEF DEBUG}
  376.   CheckBreak := true; {enable CONTROL-C checking}
  377. {$ENDIF}
  378.  
  379.   if paramcount < 2 then {only display if not in "engine" mode}
  380.     titlescreen;
  381.  
  382.   {Initialize variables}
  383.   Cmmd := 1;
  384.   initial;
  385.  
  386.   if paramcount < 2 then begin
  387.  
  388.     { Here is the main menu loop: }
  389.     repeat
  390.       Cmmd := 2;
  391.       menu (Cmmd);
  392.       if (Cmmd > 1) and (Cmmd < 5) and (not Fileread) then begin
  393.         writeln ('Please select a data file first.');
  394.         write ('Press any key to continue...');
  395.         ch := readkey;
  396.         Cmmd := 5;
  397.       end;
  398.  
  399.       case Cmmd of
  400.         1: paramenu;
  401.         2: wireframe;
  402.         3: hiddenline;
  403.         4: if (Interpolate) then
  404.              gouraud
  405.            else
  406.              surface;
  407.         5: begin
  408.           file_select ('*.SRF', Flnm);
  409.           if (Flnm <> '') then begin
  410.             readfile (Flnm);
  411.             Viewchanged := TRUE;
  412.           end;
  413.         end;
  414.       end;
  415.     until (Cmmd = 0) or (paramcount = 3);
  416.   end else begin
  417.     { Process command from cmmd-line }
  418.     if paramcount > 2 then
  419.       Save_cmmd := paramstr(3);
  420.     if paramstr(2) = '2' then
  421.       wireframe
  422.     else if paramstr(2) = '3' then
  423.       hiddenline
  424.     else if paramstr(2) = '4' then
  425.       if interpolate then
  426.         gouraud
  427.       else
  428.         surface
  429.     else begin
  430.       clrscr;
  431.       writeln ('Option "',paramstr(2),'" is not recognized.');
  432.       writeln ('Use a number between 2 and 4');
  433.       writeln ('Program halted');
  434.       halt(1);
  435.     end;
  436.   end;
  437.  
  438.   window (1,1,80,25);
  439.   clrscr;
  440. end. { program SURFMODL }
  441.